home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / tjgold.zip / INSTALL.003 / DEMDB11.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-29  |  5KB  |  177 lines
  1. {--------------------------------------------------------------------------}
  2. {                Product: TechnoJock's Turbo Toolkit GOLD                  }
  3. {                                                                          }
  4. {                     TTT GOLD - DEMO PROGRAM                        }
  5. {                                                                          }
  6. {                Copyright 1986-1995  TechnoJock Software, Inc.            }
  7. {                           All Rights Reserved                            }
  8. {                          Restricted by License                           }
  9. {--------------------------------------------------------------------------}
  10.  
  11. {Description: DEMDB11.PAS
  12.  
  13. }
  14.  
  15. program demdb11;
  16.  
  17. uses crt, dos, GoldFast, GoldStr, GoldLink, GoldList, GoldDb, GoldAttr,
  18.                GoldDate, GoldWin, GoldIO, GoldIO2, GoldKey;
  19.  
  20. const FN: string[12] = 'DEMCUST.DBF';
  21.  
  22. var FormWinNum: integer;
  23.     ListFldVar: integer;
  24.     Handle: integer;
  25.     ECode, X: integer;
  26.     RadioFldVar: byte;
  27.     Choice: gAction;
  28.     List: SingleLL;
  29.     ListDetails: ListCfg;
  30.  
  31. procedure SetScreen;
  32. {}
  33. begin
  34.    Clear(LightGrayOnBlack,'░');
  35.    ClearLine(1,WhiteOnBlue);
  36.    ClearLine(25,WhiteOnBlue);
  37. end; { SetScreen }
  38.  
  39. function BuildList:boolean;
  40. {Returns true if there are deleted records}
  41. begin
  42.    SLLSetActiveList(List);
  43.    Ecode := 0;
  44.    for X := 1 to DbGetNumRecs do
  45.    begin
  46.       if not DbRecordIsActive(X) then
  47.          inc(Ecode,SLLAddStr(PadLeft(IntToStr(X),5,' ')+'│'+ {include recno}
  48.                     JulToStr(DbGetFldDate(X,1),MMDDYY)+'│'+
  49.                              DbGetFldString(X,2)+'│'+
  50.                              DbGetFldString(X,3)+'│'{+
  51.                              DbGetFldString(X,4)+'│'+
  52.                              DbGetFldString(X,5)+'│'+
  53.                              DbGetFldString(X,6)+'│'+
  54.                              DbGetFldString(X,7)+'│'+
  55.                              DbGetFldString(X,8)+'│'}));
  56.    end;
  57.    if List.TotalNodes = 0 then
  58.    begin
  59.       if Ecode = 0 then
  60.          PromptOK(' Message ','There are no deleted records|in database '+FN)
  61.       else
  62.          PromptOK(' Error ','Unable to build list of deleted records');
  63.    end
  64.    else if Ecode <> 0 then
  65.       PromptOK(' Warning ','To many delete records to display them all');
  66.    BuildList := List.TotalNodes > 0;
  67. end; { BuildList }
  68.  
  69. function TaggedNodes: longint;
  70. {}
  71. var I, X: longint;
  72. begin
  73.    I := 0;
  74.    for X := 1 to List.TotalNodes do
  75.       inc(I,ord(SLLGetTagState(X)));
  76.    TaggedNodes := I;
  77. end;
  78.  
  79. {$IFOPT F-}
  80.    {$DEFINE FOFF}
  81.    {$F+}
  82. {$ENDIF}
  83.  
  84. procedure HindHook(CurrentField:byte;var Refresh:byte);
  85. {}
  86. var On: boolean;
  87. begin
  88.    if (List.TotalNodes > 0) then
  89.    begin
  90.       On := (TaggedNodes <> 0);
  91.       FieldSetState(3, gActiveState(ord(On)));
  92.       FieldSetState(4, gActiveState(ord(On)));
  93.    end;
  94.    Refresh := RefreshAll;
  95. end; { HindHook }
  96.  
  97. {$IFDEF FOFF}
  98.    {$F-}
  99.    {$UNDEF FOFF}
  100. {$ENDIF}
  101.  
  102. procedure BuildForm;
  103. {}
  104. begin
  105.    CreateForms(1);
  106.    ActivateForm(1);
  107.    AllowEsc(true);
  108.    SetFormWindow(5,3,75,23,2);
  109.    WinSetTitle(FormWinNum,' List of Deleted Records ');
  110.    WinSetType(FormWinNum,WMove);
  111.    WinSetShowNum(FormWinNum,false);
  112.    AssignHindHook(HindHook);
  113.    KwikAddField(1, 5,2); { list field }
  114.    KwikAddField(2, 6,18); { button field }
  115.    KwikAddField(3, 15,18); { buttonfield }
  116.    KwikAddField(4, 40,18); { button field }
  117.    KwikAddLastField(5, 54,18); { button field }
  118.    ListAssignSLL(ListDetails,List);
  119.    WrapListField(1,60,1,15,ListDetails);
  120.    ButtonDefaultField(2,'~T~ag',Stop1);
  121.    ButtonField(3,'~U~nTag',Stop2);
  122.    ButtonField(4,'Un~d~elete',Stop3);
  123.    ButtonField(5,'  ~Q~uit  ',Finished);
  124.    SetHK(2,276); {alt-T}
  125.    SetHK(3,278); {alt-U}
  126.    SetHK(4,288); {alt-D}
  127.    SetHK(5,272); {alt-Q}
  128. end; { BuildForm }
  129.  
  130. procedure SetVars;
  131. {}
  132. begin
  133.    RadioFldVar := 2;
  134.    ListFldVar := 1;
  135.    InitSLLStr(List);
  136. end; { SetVars }
  137.  
  138. begin
  139.    SetScreen;
  140.    SetVars;
  141.    MouseShow(true);
  142.    CursorOff;
  143.    Handle := DbOpenDataSet(FN);
  144.    if Handle > 0 then
  145.    begin
  146.       InitListCfg(ListDetails);
  147.       ListSetTagging(ListDetails, true);
  148.       DbSetFullStrings(true);
  149.       if BuildList then
  150.       begin
  151.          BuildForm;
  152.          repeat
  153.             Choice := EditForm(1);
  154.             case Choice of
  155.                Stop1: SetTag(ListDetails,true);
  156.                Stop2: SetTag(ListDetails,false);
  157.                Stop3: begin
  158.                          for X := 1 to List.TotalNodes do
  159.                             if SLLGetTagState(X) then
  160.                                DbUnDeleteRecord(StrToLong(
  161.                                   Strip('A',' ',copy(SLLGetStr(X),1,5))));
  162.                          SLLDelAllStatus(TagBit,true);
  163.                          if (List.TotalNodes = 0) then
  164.                             Choice := Finished;
  165.                       end;
  166.             end;
  167.          until (Choice in [Finished,Escaped]);
  168.       end;
  169.       SLLSetActiveList(List);
  170.       SLLDestroy;
  171.    end
  172.    else
  173.       PromptOK(' ERROR ','Unable to open '+FN);
  174.    MouseShow(false);
  175.    ResetStartUpMode;
  176. end.
  177.